home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / database / tickle15.zip / REPORT.PPS < prev    next >
Text File  |  1996-08-02  |  6KB  |  171 lines

  1. STRING dbfields(49), usr_name, hold, reg_code, user_input
  2.  
  3. LONG record_num, value, total_records
  4.  
  5. INT x, count, y
  6.  
  7. FLOAT files_per_user, total_users, total_files, total_users_wfiles
  8. FLOAT total_users_wofiles
  9.  
  10.  
  11.  
  12. :MAIN_BEGIN
  13.  
  14.    GOSUB OPEN_DATABASE
  15.    IF (DERR(0)) THEN
  16.      NEWLINE
  17.      PRINTLN "Cannot open TICKLE.DBF (DataBase) - Aborting"
  18.      NEWLINE
  19.      LOG "Cannot open TICKLE.DBF (DataBase) - Aborting", FALSE
  20.      WAIT
  21.      END
  22.    END IF
  23.  
  24.    STARTDISP FNS
  25.    FAPPEND 1, PPEPATH() + "TKLREPRT.LOG", O_RW, S_DN
  26.    FPUTLN 1, "───────────────────────────────────────────────────-"
  27.    FPUTLN 1, "REPORT.PPE - A 'Tickle File' Database Report Program"
  28.    FPUTLN 1, ""
  29.    FPUTLN 1, "          Written by:  Dan Shore - SysOp"
  30.    FPUTLN 1, "                       The Shoreline BBS"
  31.    FPUTLN 1, ""
  32.    FPUTLN 1, "          Copyright 1995,1996 (c) - Dan Shore"
  33.    FPUTLN 1, ""
  34.  
  35.    total_records = DRECCOUNT(0)
  36.  
  37.    WHILE (record_num < total_records) DO
  38.      INC record_num
  39.      DGO 0, record_num
  40.      IF (DERR(0)) BREAK
  41.      hold = DGET (0, DNAME(0,1))
  42.      hold = TRIM(hold, " ")
  43.      hold = MIXED(hold)
  44.      PRINTLN "Processing UserName: ", HOLD
  45.  
  46.      INC total_users
  47.      count = 0
  48.      FPUTLN 1, "──────────────────────────────────────────────────────────────────────"
  49.      FPUT 1,  hold + " has "
  50.      hold = DGET(0,DNAME(0,2))
  51.      IF (DDELETED(0)) THEN
  52.        FPUTLN 1,  "-* been flagged for Deletion *- "
  53.        INC total_users_wofiles
  54.        CONTINUE
  55.      ELSEIF (DGET(0,DNAME(0,2)) = "            ") THEN
  56.        FPUTLN 1,  "-* NO FILES *- in their database"
  57.        INC total_users_wofiles
  58.        CONTINUE
  59.      ELSE
  60.        FPUTLN 1, "these files in their database:"
  61.        FPUTLN 1, ""
  62.        INC total_users_wfiles
  63.      END IF
  64.      FOR x = 2 TO 25
  65.        IF (DGET(0,DNAME(0,x)) = "            ") THEN
  66.          FPUTLN 1, ""
  67.          FPUTLN 1, ""
  68.          BREAK
  69.        END IF
  70.        INC total_files
  71.        INC count
  72.        hold = SPACE(2-LEN(STRING(x-1))) + STRING(x-1) + ".  " + DGET(0,DNAME(0,x)) + SPACE(2)
  73.        FPUT 1, hold
  74.        hold = LOWER(DGET(0,DNAME(0,x+24)))
  75.        FPUT 1, HOLD + SPACE(1)
  76.        IF (count%2 = 0) THEN
  77.          FPUTLN 1, ""
  78.          count = 0
  79.        END IF
  80.      NEXT
  81.    END WHILE
  82.    FPUTLN 1, "──────────────────────────────────────────────────────────────────────"
  83.    FPUTLN 1, ""
  84.    FPUTLN 1, ""
  85.    FPUTLN 1, "     ************************************************************"
  86.    FPUTLN 1, ""
  87.    FPUTLN 1, "                'Tickle File' Statistics Summary Report"
  88.    FPUTLN 1, ""
  89.    FPUTLN 1, ""
  90.    FPUTLN 1, "                         Total Users in Database : " + STRING(total_users)
  91.    FPUTLN 1, "                         Total Files in Database : " + STRING(total_files)
  92.    FPUTLN 1, "              Total Users with Files in Database : " + STRING(total_users_wfiles)
  93.    FPUTLN 1, "           Total Users without Files in Database : " + STRING(total_users_wofiles)
  94.    files_per_user = total_files/total_users_wfiles
  95.    FPUTLN 1, "           Files Per User with Files in Database : " + STRING(files_per_user)
  96.    FPUTLN 1, ""
  97.    FPUTLN 1, "     ************************************************************"
  98.    FCLOSE 1
  99.    STARTDISP FCL
  100.    END
  101.  
  102. '
  103. '  Subroutine to open/create database files
  104. '
  105. :OPEN_DATABASE
  106.  
  107.    IF (!EXIST(PPEPATH()+"tickle.dbf")) THEN
  108.      '
  109.      ' Database structure initialization
  110.      '
  111.      ' 24 fields - Field 1    = Users Name (Up to 25 Characters - PCB Limit)
  112.      '             Field 2-24 = Filenames  (Up to 12 Characters - DOS Limit)
  113.      '
  114.      dbfields(0)  = "usr_name,C,25,0"
  115.  
  116.      dbfields(1)  = "file1,C,12,0"
  117.      dbfields(2)  = "file2,C,12,0"
  118.      dbfields(3)  = "file3,C,12,0"
  119.      dbfields(4)  = "file4,C,12,0"
  120.      dbfields(5)  = "file5,C,12,0"
  121.      dbfields(6)  = "file6,C,12,0"
  122.      dbfields(7)  = "file7,C,12,0"
  123.      dbfields(8)  = "file8,C,12,0"
  124.      dbfields(9)  = "file9,C,12,0"
  125.      dbfields(10) = "file10,C,12,0"
  126.      dbfields(11) = "file11,C,12,0"
  127.      dbfields(12) = "file12,C,12,0"
  128.      dbfields(13) = "file13,C,12,0"
  129.      dbfields(14) = "file14,C,12,0"
  130.      dbfields(15) = "file15,C,12,0"
  131.      dbfields(16) = "file16,C,12,0"
  132.      dbfields(17) = "file17,C,12,0"
  133.      dbfields(18) = "file18,C,12,0"
  134.      dbfields(19) = "file19,C,12,0"
  135.      dbfields(20) = "file20,C,12,0"
  136.      dbfields(21) = "file21,C,12,0"
  137.      dbfields(22) = "file22,C,12,0"
  138.      dbfields(23) = "file23,C,12,0"
  139.      dbfields(24) = "file24,C,12,0"
  140.  
  141.      dbfields(25) = "desc1,C,15,0"
  142.      dbfields(26) = "desc2,C,15,0"
  143.      dbfields(27) = "desc3,C,15,0"
  144.      dbfields(28) = "desc4,C,15,0"
  145.      dbfields(29) = "desc5,C,15,0"
  146.      dbfields(30) = "desc6,C,15,0"
  147.      dbfields(31) = "desc7,C,15,0"
  148.      dbfields(32) = "desc8,C,15,0"
  149.      dbfields(33) = "desc9,C,15,0"
  150.      dbfields(34) = "desc10,C,15,0"
  151.      dbfields(35) = "desc11,C,15,0"
  152.      dbfields(36) = "desc12,C,15,0"
  153.      dbfields(37) = "desc13,C,15,0"
  154.      dbfields(38) = "desc14,C,15,0"
  155.      dbfields(39) = "desc15,C,15,0"
  156.      dbfields(40) = "desc16,C,15,0"
  157.      dbfields(41) = "desc17,C,15,0"
  158.      dbfields(42) = "desc18,C,15,0"
  159.      dbfields(43) = "desc19,C,15,0"
  160.      dbfields(44) = "desc20,C,15,0"
  161.      dbfields(45) = "desc21,C,15,0"
  162.      dbfields(46) = "desc22,C,15,0"
  163.      dbfields(47) = "desc23,C,15,0"
  164.      dbfields(48) = "desc24,C,15,0"
  165.  
  166.      DCREATE 0, PPEPATH()+"tickle", FALSE, dbfields
  167.    ELSE
  168.      DOPEN 0, PPEPATH()+"tickle", FALSE
  169.    END IF
  170.    RETURN
  171.